home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
jx4nt123.zip
/
UTILS
/
MEMORY.UTF
(
.txt
)
< prev
next >
Wrap
Null Bytes Alternating
|
1994-08-26
|
4KB
|
76 lines
\ memory.utf .. external memory allocation system calls
\ Copyright (c)1994 Jack J. Woehr
\ P.O. Box 51, Golden, Colorado 80402-0051
\ jax@well.sf.ca.us 72203.1320@compuserve.com
\ SYSOP RCFB (303) 278-0364 2400/9600/14400
\ All Rights Reserved
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ This is free software and can be modified and redistributed under
\ certain conditions described in the file COPYING.TXT. The
\ Disclaimer of Warranty and License for this free software are also
\ contained in the file COPYING.TXT.
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ $Revision: 1.3 $
\
MARKER memory.utf
\ ~~~~~~~~~~~~~~~~~~~~
\ Conditional INCLUDED
\ ~~~~~~~~~~~~~~~~~~~~
: PROVIDES ( c-addr u "ccc< >" --)
BL WORD FIND NIP 0=
IF INCLUDED ELSE 2DROP THEN ;
S" UTILS\UTILS.UTF" PROVIDES USEFUL
S" UTILS\SYSCALLS.UTF" PROVIDES LIBRARY
CR .( Loading Memory Allocation words) CR
USEFUL DECIMAL
SYSTEM-WORDLIST SET-CURRENT
\ System Calls
S" GlobalAlloc" KERNEL32 SYSTEMCALL GLOBALALLOC
S" GlobalReAlloc" KERNEL32 SYSTEMCALL GLOBALREALLOC
S" GlobalFree" KERNEL32 SYSTEMCALL GLOBALFREE
S" GetLastError" KERNEL32 SYSTEMCALL GETLASTERROR
\ Forth ALLOCATE defined in terms of above.
\ Remeber to OPEN-ALL and RESOLVE-ALL before using.
: ALLOCATE ( u -- a-addr ior)
0 GLOBALALLOC NIP ( discard second return) DUP 0=
IF GETLASTERROR NIP ( ditto) DUP LastError !
ELSE ABSTODATA FALSE
THEN
;
\ Forth FREE defined in terms of above.
\ Remeber to OPEN-ALL and RESOLVE-ALL before using.
: FREE ( a-addr -- ior)
DATATOABS GLOBALFREE NIP
IF GETLASTERROR NIP DUP LastError !
ELSE FALSE
THEN
;
\ Forth RESIZE defined in terms of above.
\ Remeber to OPEN-ALL and RESOLVE-ALL before using.
: RESIZE ( a-addr1 u -- a-addr2 ior)
SWAP 0 ROT ROT DATATOABS \ -- 0 u abs-addr
GLOBALREALLOC NIP ( discard second return) DUP 0=
IF GETLASTERROR NIP ( ditto) DUP LastError !
ELSE ABSTODATA FALSE
THEN
;
USEFUL
\ ~~~~~~~~~~~~~~~~~
\ End of memory.utf
\ ~~~~~~~~~~~~~~~~~